;;=======================================================
;; dataobj3.lsp
;; Copyright (c) 1991-99 by Forrest W. Young
;;
;; contains menu item methods
;; ABOUT-THESE-DATA, LIST-DATA, DATA-HEADER, SUMMARIZE-DATA, and CROSSTABULATE-DATA
;;
;; This file contains methods for reporting summary information about the data
;;=======================================================

; Used by menu item and keyboard

(defun data-header ()
  (about-these-data nil :header t))

(defun about-these-data  (&optional string 
                          &key title (show t) location size (header nil) (pop-out t))
"Args: &OPTIONAL STRING &KEY TITLE (SHOW t) LOCATION SIZE HEADER (POP-OUT T)
If STRING is not nil, changes about information to STRING. If STRING is NIL,  shows the about information for the current data  in *about-window*.  Returns *about-window*"
  (cond 
    (string (send *current-data* :about string) t)
    (*current-data*
     (unless (send *current-data* :about) 
             (send *current-data* :about "There is no information about these data."))
     (setf *about-window* (summarize-data :data nil :about t :header header
                                          :moments nil :quartiles nil :ranges nil
                                          :correlations nil :covariances nil 
                                          :frequencies nil))
    (display-string (format nil "~2%") *about-window*)
     (send *about-window* :fit-window-to-text)
     (send *about-window* :scroll 0 0)
     (apply #'send *about-window* :size (+ '(0 20) (send *about-window* :size)))
     (send *about-window* :front-window)
     )
    (t (help "There is no current data.")))
  *about-window*)

(defun crosstabulate-data ()
 "Args: None
Shows crosstabulation tables of the active data in *current-data* in the *about-window*. Returns *about-window*"
  (send *current-data* :visualize-data :dialog nil :category t)
  )

(defun show-moments () 
  (send $ :summary :dialog nil
        :moments t :quartiles nil :ranges nil 
       :correlations nil :covariances nil :distances nil :frequencies nil))

(defun show-quartiles-and-ranges ()
  (send $ :summary :dialog nil
        :moments nil :quartiles t :ranges t 
       :correlations nil :covariances nil :distances nil :frequencies nil))

(defun show-correlations-and-covariances ()
  (send $ :summary :dialog nil :correlations t
        :moments nil :quartiles nil :ranges nil :frequencies nil :distances nil ))

(defun show-distances ()
  (send $ :summary :dialog nil
        :moments nil :quartiles nil :ranges nil 
       :correlations nil :covariances nil :distances t :frequencies nil))

(defun show-crosstabulation () (crosstabulate-data)) 

(defun list-data ()
"Args: None
Shows a listing of the active data in *current-data* in the *about-window*. Returns *about-window*"
  (setf *about-window* (summarize-data :data t :about nil :moments nil :quartiles nil
                                       :ranges nil :correlations nil  :covariances nil 
                                       :frequencies nil))
  (send *about-window* :title (strcat "Listing of the " (send *current-data* :proper-name) " data."))
  (send *about-window* :fit-window-to-text)
  (send *about-window* :scroll 0 0)
  (send *about-window* :front-window)
  *about-window*)

(defun summarize-data 
  (&key (data nil) 
        (moments t) (quartiles t) (ranges t) ( correlations t) (covariances t) 
        (frequencies t) (about nil) (dialog nil) (header nil)
        (pop-out t) (free nil) (container nil) (shrink-wrap t))
"Args: (&key (dialog nil)
             (moments t) (quartiles t) (ranges t) (correlations t) (covariances t)
             (frequencies t) (about nil) (dialog)
Presents univariate summary statistics for each the active variables in the current data object. If dialog is t a dialog box is presented to determine which statistics are to be printed, otherwise the other keywords determine which are printed. Returns window object."
  (send current-data :summarize-data :data data :about about :header header
        :moments moments :quartiles quartiles
        :ranges ranges :correlations correlations :covariances covariances
        :frequencies frequencies :dialog dialog :pop-out pop-out
        :free free :container container :shrink-wrap shrink-wrap))

(defun summary 
  (&key (dialog nil)
        (moments t) (quartiles t) (ranges t) ( correlations t) (covariances t) 
        (frequencies t) (data nil) (about nil) (header nil)
        (pop-out t) (free nil) (container nil) (shrink-wrap t))
"Alias of summarize-data"
  (send current-data :summarize-data :data data :about about :header header
        :moments moments :quartiles quartiles
        :ranges ranges :correlations correlations :covariances covariances
        :frequencies frequencies :dialog dialog :pop-out pop-out
        :free free :container container :shrink-wrap shrink-wrap))


;used by toolbar button
(defmeth mv-data-object-proto :summarize (&rest args)
"Alias of :summarize-data"
  (apply #'send self :summarize-data args))


(defmeth mv-data-object-proto :summarize-data 
 (&key (data nil) (about nil) (header nil) (dialog nil) (from-menu nil) 
        (moments t) (quartiles t) 
        (ranges t) ( correlations t) (covariances t) (frequencies nil) 
        (pop-out t) (free nil) (container nil) (shrink-wrap t))
"Args: (&key (data nil) (about nil) (header nil) (dialog nil) (from-menu nil) 
        (moments t) (quartiles t) 
        (ranges t) ( correlations t) (covariances t) (frequencies nil) 
        (pop-out t) (free nil) (container nil) (shrink-wrap t))
Presents univariate summary statistics for each the active data in the current data object. Can also present about information, and data listing. If dialog is t a dialog box is presented to determine which statistics are to be printed, otherwise the other keywords determine which are printed. Returns window object."
  (if (not (eq *current-data* self)) (setcd self))
  (let* ((icon (select (send *workmap* :icon-list) 
                       (1- (send self :icon-number))))
         (window)
         )
    (send *workmap* :stop-screen-saver)
    ;(send icon :do-click "stats");fwy removed -916-2
    (setf window 
          (send self :summary :data data :about about :header header
                :moments moments :quartiles quartiles :ranges ranges
                :correlations correlations :covariances covariances
                :frequencies frequencies :dialog dialog :show t
                :from-menu from-menu :pop-out pop-out
                :free free :container container :shrink-wrap shrink-wrap))
    (send icon :stats-icon-clicked-on nil)
    (send icon :stats-hilited nil)
    (send icon :draw-stats-icon)
    (send *workmap* :reset-screen-saver)
    (when window (send window :scroll 0 0))
    window))

(defmeth mv-data-object-proto :summary 
  (&key data about (header nil) (dialog nil) (from-menu nil) 
        (moments t) (quartiles t) (distances nil) (date (date-time))
        (ranges t) (correlations nil) (covariances nil) (frequencies t) (show t)   
        (pop-out t) (free nil) (container nil) (shrink-wrap t) )
"Method Args: (&key data about header dialog from-menu 
        (moments t) (quartiles t) distances (date (date-time))
        (ranges t) correlations covariances (frequencies t) (show t)   
        (pop-out t) (free nil) (container nil) (shrink-wrap t) ) 
Prints selected summary statistics for the active data. If dialog is t a dialog box is presented to determine which statistics are to be printed, otherwise the other keywords determine which are printed. By default, if no dialog and no keywords, then the data and the moments, quartiles and ranges are shown."
  (if (not (eq current-object self)) (setcd self))
  (let ((w nil)
        (header-text)
        (resp-var nil)
        (summary-options nil))
    (if dialog                                  ;a menu item requests summary
        (setf summary-options (send self :summary-options-dialog))
        (setf summary-options 
              (list (delete 'nil 
              (list (when data '0) (when moments '1) (when quartiles '2) (when ranges  '2)
                    (when correlations '3) (when covariances '3) (when distances '5) 
                    (when frequencies '4))))))
    (when summary-options
          (send self :summary-option-states summary-options)
          (setf header-text (cond
                              (header "Data Header:")
                              (about "Information About:") 
                              (data "Listing of:") 
                              (t "Satistics Summarizing:")))
          (setf w (report-header (strcat (send self :proper-name) " - " header-text)
                                 :show show :location '(50 20) :size '(600 250)
                                 :page t :pop-out pop-out :free free :container container))
          (display-string (format nil "ViSta - The Visual Statistics System~%~a~2%"
                                  (strcat (third date) ", " 
                                          (first date) " - " 
                                          (sixth date))) w)

          (display-string (format nil "~a~2%Data: ~a~%File: ~a"
                                 (string-upcase header-text) 
                                  (send self :proper-name) 
                                  (if (send self :datafile)
                                      (send self :datafile)
                                      "Unsaved Data")
                                      ) w)
;about data
          (when about (send self :data-info-about-only w ))
;data header
          (when header (send self :data-info w nil (and (not data) about)))
;data listing
          (when (or (member 0 (first summary-options))
                    (member 4 (first summary-options)))
                (setf w (send self :report nil w )))
;summary stats
          (when (and (not (equal (send self :data-type) "missing")) ;PV
                     (send self :active-types '(numeric ordinal))
                     (or (member 1 (first summary-options));moments
                         (member 2 (first summary-options));quartiles & ranges
                         (member 3 (first summary-options));correlations & covariances
                         (member 5 (first summary-options))));distances
                (setf w  (send self :describe-data 
                               (column-list
                                (send self :active-data-matrix '(all)))
                               (if (send self :matrices)
                                   (send self :matrices)
                                   (send self :active-variables '(all)))
                               summary-options
                               :types (if (send self :matrices) nil
                                          (send self :active-types '(all)))
                               :window w)))
;missing
          (when (equal (send self :data-type) "missing")
                (send self :report-missing-data))
;finished
          (when shrink-wrap (send w :fit-window-to-text))
          (send w :scroll 0 0)
          (send w :top-most t)
          (setf *about-window* w)
          w)))



(defmeth mv-data-object-proto :summary-options-dialog ()
  (let* ((data-type (send self :data-type))
         (result-list)
         (loc)
         (result (if (equal data-type "missing")
                     (send self :report-missing-data) ;PV 12/10/2001
                     (choose-subset-dialog 
                      "Choose Summary Information:"
                      (cond 
                        ((member (string-downcase data-type)
                                 '("univariate" "bivariate" "multivariate" 
                                                "general" "crosstabs")
                                 :test #'equal)
                         (cond 
                           ((and (send self :active-types '(numeric ordinal))
                                 (send self :active-types '(category)))
                            '("Data Listing"
                              "Moments (Mean, StDv, etc.)" 
                              "Quartiles and Ranges" 
                              "Correlations and Covariances between Variables"
                              "Frequency Matrices"
                              "Distances Between Observations Across Variables"))
                           ((send self :active-types '(numeric ordinal))
                            '("Data Listing" "Moments (Mean, StDv, etc.)" 
                              "Quartiles and Ranges" 
                              "Correlations and Covariances between Variables"
                              "Distances Between Observations Across Variables"))
                           ((send self :active-types '(category))
                            '("Category Data Listing" "Frequency Matrices"))))
                        ((equal data-type "category")
                         '("Category Data Listing" 
                                     "Frequency Matrices"))
                        ((equal data-type "class")
                         '("Classification Data Listing" 
                                           "Moments (Mean, StDv, etc.)" 
                                           "Quartiles and Ranges" 
                                           "Frequency Matrices"))
                        ((member (string-downcase data-type) 
                                 '("freqclass" "freq"):test #'equal)
                         '("Frequency Data Listing" 
                                      "Moments (Mean, StDv, etc.)" 
                                      "Quartiles and Ranges"  
                                      "Correlations and Covariances between Variables"
                                      "Distances Between Observations Across Variables"))
                        ((equal data-type "matrix")
                         '("Matrix Data Listing" 
                                   "Moments (Mean, StDv, etc.)" 
                                   "Quartiles and Ranges"))
                        )
                      :initial (send self :summary-option-states)))))
    (when result
          (when (first result)
                (setf result-list (first result))
                (cond
                   ((equal data-type "multivariate")
                   (when (and (send self :active-types '(category))
                              (not (send self :active-types '(numeric ordinal))))
                         (setf loc (position 1 result-list))
                         (when loc (setf (select result-list loc) 4))))
                  ((equal data-type "category")
                   (setf loc (position 1 result-list))
                   (when loc (setf (select result-list loc) 4)))
                  ((equal data-type "class")
                   (setf loc (position 3 result-list))
                   (when loc (setf (select result-list loc) 4))))
                (setf result (list result-list))
                ))
    result))

(defmeth mv-data-object-proto :data-info-about-only (w)
  (let* ((shortfilename (reverse (send self :datafile)))
         (position) 
         (shortfilename))
    (send w :title (strcat "About" (send self :name)))
    (display-string (format nil "~%") w) 
    (display-string (format nil "~%ABOUT THESE DATA:~%") w)
    (word-wrap (send *current-data* :about) w)))  


(defmeth mv-data-object-proto :data-info (w &optional (about t) vars)
  (let* ((shortfilename (reverse (send self :datafile)))
         (position) 
         (shortfilename))
    (when about
          (send w :title (strcat "About" (send self :name)))
          (display-string (format nil "~%") w) 
          (display-string (format nil "~%ABOUT THESE DATA:~%") w)
          (word-wrap (send *current-data* :about) w))
    (unless about (terpri))
    (when vars
          (display-string (format nil "~%VARIABLES INFORMATION:") w)
          (mapcar #'(lambda (var type)
                      (display-string (format nil "~%~a (~a)"var type) w))
                  (send self :variables)
                  (send self :types)))

    (display-string (format nil "~%~%DATA INFORMATION:") w)
    (when (send self :datafile)
          (display-string (format nil "~%DataFile:       ~a" (send self :datafile)) w))
    (display-string (format nil "~%DataName:       ~a" (send self :name)) w)
    (display-string (format nil "~%DataType:       ~a" (send self :generalized-data-type)) w)
    (display-string (format nil "~%Number of Obs:  ~d" (send self :active-nobs)) w)
    (display-string (format nil "~%Number of Vars: ~d" (send self :active-nvar '(all))) w)
    (display-string (format nil "~%Missing Values: ~a" (if (send self :missing-values) "Yes" "No")) w)
    (display-string (format nil "~%Frequency Data: ~a" (if (send self :freq) "Yes" "No")) w)
    (display-string (format nil "~%CrossTab Data:  ~a" 
                            (if (send self :array) 
                                (format nil "~a-way data" 
                                        (length (array-dimensions (send self :active-data-array))))
                                "No")) w)
    (when (send self :array)
        (display-string 
                  (format nil   "~%                Number of Levels/Way ~a" 
                 (array-dimensions (send self :active-data-array))) w)
        (display-string
         (format nil            "~%                Number of Cells  ~a" 
                 (prod (array-dimensions (send self :active-data-array)))) w)
        )
  
        (display-string (format nil "~%~%DATAOBJECT INFORMATION:~%") W)
        (display-string (format nil "ProtoType:      ~a~%" (string-capitalize 
                                       (send self :slot-value 'proto-name))) w)
        (display-string (format nil "StatObjectType: ~a~%" (send self :make-vistatype)) w)
        (display-string (format nil "Instantiated:   ~a~%" (send self :slot-value 'instance-info)) w)
        (display-string (format nil "PrintSymbol:    ~a~%" (send $ :proper-name)) w)
        (display-string (format nil "Address:        ~d~%" (address-of self)) w)
        (display-string (format nil "Elapsed:        ~,4d seconds~%" (fuzz (send self :elapsed-time) 3)) w)
        
   ; (send w :fit-window-to-text)
    ))
  


(defmeth mv-data-object-proto :describe-data 
               (variables varnames stats &key group types table window (draw-line t))
"Method Args: (variables varnames stats &key group types table window)
Used by summary method to compute and print desired summary statistics for columns of VARIABLES, a list of variable lists. VARNAMES contains strings that are column names. STATS is a list with up to five elements indicating stats to be printed: 1=moments, 2=quartiles & ranges 3=correlations; 4=covariances; 5=distances. Printing table for variable TABLE when table is not nil."
  (let* ((data-matrix nil)
         (row-column-labels)
         (w window)
         (varnamenow nil)
         (novarvar nil)
         )
    (when w 
          (if draw-line
              (display-string (format nil "~%_________________________________~2%") w)
              (display-string (format nil "~2% ") w))
          (display-string (format nil   "Summary Statistics") w)
          (if group (display-string (format nil " for ~a~2%" group) w)
              (display-string (format nil "~2%") w))
          )
    (unless (or w table)
            (setf w (report-header 
                     (strcat (send self :name) " Summary Statistics")))
            (display-string (format nil   "Summary Statistics~2%") w)
            (display-string (format nil   "Title: ~a" (send self :title)) w)
            (display-string (format nil "~%Data:  ~a ~2%" (send self :name)) w))
   
    (cond     
      ((< (length (first variables)) 2)
       (setf novarvar t)
       (display-string 
        (format nil "Statistics cannot be computed: 1 Observation") w)
       )
      (t
       (when (member 1 (first stats))
             (send self :describe-moments w table varnames variables types)) 
       (when (member 2 (first stats)) 
             (send self :describe-quartiles w table varnames variables types))   
       (when (or (member 3 (first stats))
                 (member 4 (first stats))
                 (member 5 (first stats)))
             (cond
               (novarvar
                (display-string 
                 (format nil 
                    "~%Too Few Numeric Variables:~%Correlations, Covariances and Distances cannot be computed.~%") w))
               (table
                (display-string 
                 (format nil 
                    "~%Correlations and Covariances not computed between cells.~%") w))
               (t 
                (send self :describe-relations w table varnames variables (first stats)))))))
             
    (when (not w) (terpri)) ; fwy4.28
    w ))


(defmeth mv-data-object-proto :describe-moments 
  (w table varnames variables types)
  (let ((data-matrix nil)
        (nactvar (length variables))
        (row-column-labels)
        (varnamenow)
        (varn)
        (varnow) 
        (varmean) 
        (varstdv)
        (varvari) 
        (varskew) 
        (varkurt)
        )
    (unless types (setf types (send self :active-types '(all)))) 
    (if table
        (display-string 
            (format nil 
                    "~2%VARIABLE: ~a (summary statistics for individual cells)~%CELL NAMES         " table) w)
           (display-string (format nil "VARIABLES (Numeric)") w))
       (display-string (format nil 
                                 "       MEAN      StDv   VARIANCE  SKEWNESS  KURTOSIS    N") w)
       (dotimes 
        (i nactvar)
        (when 
           (or (send self :matrices)
               table
               (and (not (send self :matrices))
                    (equalp "numeric" (select types i))))
           (setf varnamenow (select varnames i))
           (when (> (length varnamenow) 20)
                 (setf varnamenow (subseq varnamenow 0 20)))
           (setf varnow  (select variables i))
           (setf varn (length varnow))
           (setf varmean (mean varnow))
           (setf varstdv 0)
           (display-string 
            (format nil "~%~20a ~9,2f " 
                    varnamenow (+ .00001 varmean) ) w) 
           (when (> varn 1) (setf varstdv (standard-deviation varnow)))
           (when (= varn 1) (display-string (format nil "    N equals 1.  ") w))
           (cond 
             ((= 0 varstdv)
              (setf novarvar t)
              (display-string 
               (format nil "Moment Statistics Undefined.") w))
             (t
              (cond ((> varn 1)
                     (display-string 
                      (format nil "~9,2f ~9,2f " (fuzz varstdv) (fuzz (^ varstdv 2))) w))
                (t (display-string (format nil "    undef     undef ") w)))
              (cond ((and (> varn 2) (> varstdv 0))
                     (setf varskew (skewness varnow))
                     (display-string  (format nil "~9,2f " (fuzz varskew)) w))
                (t (display-string (format nil "    undef ") w)))
              (cond ((and (> varn 3) (> varstdv 0))
                     (setf varkurt (kurtosis varnow))
                     (display-string (format nil "~9,2f " (fuzz varkurt)) w))
                (t (display-string (format nil "    undef ") w)))
              (display-string (format nil "  ~5f" varn) w)))
         ))))

(defmeth mv-data-object-proto :describe-quartiles (w table varnames variables types)
  (let ((nactvar (length variables))
        (row-column-labels)
        (varnamenow)
        (varn)
        (varnow) 
        (var5num) 
        )
    (unless types (setf types (send self :active-types '(all)))) 
    (if table
        (display-string (format nil "~%                       ") w)
        (display-string (format nil "~2%VARIABLES (Ord. & Num.)") w))
    (display-string (format nil 
                            " MINIMUM    1st Q    MEDIAN     3rd Q   MAXIMUM") w)
    (dotimes (i nactvar)
             (when 
              (or (send self :matrices)
                  table
                  (and (not (send self :matrices))
                       (or (equalp "numeric" (select types i))
                           (equalp "ordinal" (select types i))
                        )))
              (setf varnamenow (select varnames i))
              (when (> (length varnamenow) 20)
                    (setf varnamenow (subseq varnamenow 0 20)))
              (setf varnow (select variables i))
              (setf var5num (fivnum varnow))
              (display-string 
               (format nil "~%~20a ~9,2f ~9,2f ~9,2f ~9,2f ~9,2f"
                       varnamenow (+ .00001 (select var5num 0)) (+ .00001 (select var5num 1))
                       (+ .00001 (select var5num 2)) (+ .00001 (select var5num 3))
                       (+ .00001 (select var5num 4))) w)))
    (if table
        (display-string (format nil "~%                   ") w)
        (display-string (format nil "~2%VARIABLES (Numeric)") w))
    (display-string (format nil "    IQ-RANGE    RANGE   MID-RANGE") w)
    (dotimes (i nactvar)
             (when 
              (or (send self :matrices)
                  table
                  (and (not (send self :matrices))
                       (equalp "numeric" 
                               (select (send self :active-types '(all)) i))))
              (setf varnamenow (select varnames i))
              (when (> (length varnamenow) 20)
                    (setf varnamenow (subseq varnamenow 0 20)))
              (setf varnow (select variables i))
              (setf iq-range (interquartile-range varnow))
              (setf mid-range (mid-range varnow))
              (setf var5num (fivnum varnow))
              (setf range (range varnow))
              (display-string 
               (format nil "~%~20a ~9,2f ~9,2f ~9,2f" 
                       varnamenow (+ .00001 iq-range) (+ .00001 range)
                       (+ .00001 mid-range)) w)))
    ))



(defmeth mv-data-object-proto :describe-relations (w table varnames variables 
                                                     &optional (stats '(3 4 )))
  (let ((data-matrix nil)
        (nactvar (length variables))
        (row-column-labels)
        (varnamenow nil)
        (novarvar nil)
        ) 
    (setf row-column-labels
          (if (send self :matrices) 
              varnames
              (select varnames ($position '("numeric") 
                                          (send self :active-types '(all))))))
    (when (and (member 3 stats) (> nactvar 1))
          
          (display-string (format nil "~2%CORRELATIONS Between Numeric Variables~%") w)
          (setf data-matrix (lists-to-matrix variables))
          (print-matrix-to-window 
           (+ (make-array (list (send self :active-nvar '(numeric))
                                (send self :active-nvar '(numeric)))
                          :initial-element .00001)
              (if (send self :matrices)
                  (fuzz (correlation-matrix data-matrix))
                  (fuzz (correlation-matrix data-matrix :types 
                                            (send self :active-types '(all))))))
           w 
           :row-heading "Variables"
           :column-heading "               Variables"
           :column-labels row-column-labels
           :row-labels row-column-labels))
    (when (and (member 3 stats)(> nactvar 1))
          (display-string (format nil "~2%COVARIANCES Between Numeric Variables~%") w)
          (when (not data-matrix) (setf data-matrix (lists-to-matrix variables)))
          (print-matrix-to-window 
           (if (send self :matrices)
               (fuzz (covariance-matrix data-matrix))
               (fuzz (covariance-matrix
                      (select data-matrix 
                              (iseq (select (size data-matrix) 0))
                              ($position '("numeric") 
                                         (send self :active-types '(all)))))))
           w 
           :row-heading "Variables"
           :column-heading "               Variables"
           :column-labels row-column-labels
           :row-labels row-column-labels))
    (when (member 5 stats)
          (cond
            ((send self :matrices)
             (display-string 
              (format nil "~2%DISTANCES cannot be computed for these data~%") w))
            (t
             (setf row-column-labels (send self :active-labels))
             (display-string (format nil "~2%DISTANCES Between Observations Using Numeric Variables~%") w)
             (print-matrix-to-window 
              (distance-matrix (send self :active-data-matrix '(numeric)))
              w 
              :row-heading "Observations"
              :column-heading "               Observations"
              :column-labels row-column-labels
              :row-labels row-column-labels))))))
  